home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / local / sbin / htpdate < prev    next >
Encoding:
Text File  |  2013-01-06  |  9.2 KB  |  317 lines
  1. #!/usr/bin/perl
  2. #
  3. # htpdate time poller version 0.9.3
  4. # Copyright (C) 2005 Eddy Vervest
  5. # Copyright (C) 2010-2011 Tails developers <tails@boum.org>
  6. #
  7. # This program is free software; you can redistribute it and/or
  8. # modify it under the terms of the GNU General Public License
  9. # as published by the Free Software Foundation; either version 2
  10. # of the License, or (at your option) any later version.
  11. # http://www.gnu.org/copyleft/gpl.html
  12.  
  13. use strict;
  14. use warnings;
  15.  
  16. use version; our $VERSION = qv('0.9.3');
  17.  
  18. use Carp;
  19. use Cwd;
  20. use Data::Dumper;
  21. use DateTime;
  22. use DateTime::Format::DateParse;
  23. use English qw( -no_match_vars );
  24. use File::Path qw(rmtree);
  25. use File::Spec::Functions;
  26. use File::Temp qw/tempdir/;
  27. use Getopt::Long::Descriptive;
  28. use List::Util qw( shuffle );
  29. use open qw{:utf8 :std};
  30. use POSIX qw( WIFEXITED );
  31. use threads;
  32. use Try::Tiny;
  33.  
  34. my $datecommand = '/bin/date';  # "date" command to set time
  35. my $dateparam   = '-s';         # "date" parameter to set time
  36. my $maxadjust   = 0;            # maximum time step in seconds (0 means no max.)
  37. my $minadjust   = 1;            # minimum time step in seconds
  38. my (
  39.     $debug, $useragent, $log, $quiet, $set_date,
  40.     $done_file, $res_file, $usage, $opt, $runas,
  41.     $allowed_per_pool_failure_ratio, $proxy, @pools,
  42. );
  43.  
  44. sub done {
  45.     if (defined $done_file) {
  46.     $> = 0 if $runas;
  47.     open my $f, '>', $done_file or
  48.         print STDERR "Couldn't write done file: $done_file\n";
  49.     close $f;
  50.     $> = getpwnam($runas) if $runas;
  51.     }
  52. }
  53.  
  54. $SIG{__DIE__} = sub {
  55.     # Avoid the "done" file to be created by an catched exception.
  56.     # When a eval block is being run, e.g. for exception catching, $^S is true.
  57.     # It is false otherwise.
  58.     done unless $^S;
  59.     die(@_);
  60. };
  61.  
  62. sub message {
  63.     my @msg = @_;
  64.  
  65.     if ($log) {
  66.         open my $h, '>>', $log or die "Cannot open log file $log: $!";
  67.         print $h "@msg\n";
  68.         close $h;
  69.     }
  70.     else {
  71.         print "@msg\n" unless $quiet;
  72.     }
  73. }
  74.  
  75. sub debug {
  76.     message(@_) if $debug;
  77. }
  78.  
  79. sub error {
  80.     debug(@_);
  81.     croak @_;
  82. }
  83.  
  84. sub parseCommandLine () {
  85.     # specify valid switches
  86.     ($opt, $usage) = describe_options(
  87.         'htpdate %o',
  88.         [ 'debug|d', "debug", { default => 0 } ],
  89.         [ 'help', "print usage message and exit" ],
  90.         [ 'quiet|q', "quiet", { default => 0 } ],
  91.         [ 'user|u:s', "userid to run as" ],
  92.         [ 'dont_set_date|x', "do not set the time (only show)", { default => 0 } ],
  93.         [ 'user_agent|a:s', "http user agent to use", { default => "htpdate/$VERSION" } ],
  94.         [ 'log_file|l:s', "log to this file rather than to STDOUT" ],
  95.         [ 'done_file|D:s', "create this file after quitting in any way" ],
  96.         [ 'success_file|T:s', "create this file after setting time successfully" ],
  97.         [ 'pal_pool=s@', "distrusted hostnames" ],
  98.         [ 'neutral_pool=s@', "neutral hostnames" ],
  99.         [ 'foe_pool=s@', "distrusted hostnames" ],
  100.         [ 'allowed_per_pool_failure_ratio:f', "ratio (0.0-1.0) of allowed per-pool failure", { default => 1.0 } ],
  101.         [ 'proxy|p:s', "what to pass to curl's --socks5-hostname (if unset, environment variables may affect curl's behavior -- see curl(1) for details)" ],
  102.     );
  103.  
  104.     usage() if $opt->help;
  105.     usage() unless $opt->pal_pool && $opt->neutral_pool && $opt->foe_pool;
  106.  
  107.     $runas       = $opt->user if $opt->user;
  108.     $>           = getpwnam($runas) if $runas;
  109.     $useragent   = $opt->user_agent;
  110.     $debug       = $opt->debug;
  111.     $log         = $opt->log_file if $opt->log_file;
  112.     $quiet       = $opt->quiet;
  113.     $set_date    = ! $opt->dont_set_date;
  114.     $done_file   = $opt->done_file if $opt->done_file;
  115.     $res_file    = $opt->success_file if $opt->success_file;
  116.     $allowed_per_pool_failure_ratio = $opt->allowed_per_pool_failure_ratio;
  117.     $proxy       = $opt->proxy if $opt->proxy;
  118.     @pools = map {
  119.         [
  120.             map {
  121.                 $_ = 'https://'.$_ unless $_ =~ /^http/i;
  122.             } split(/,/, join(',', @{$_}))
  123.         ]
  124.     } ($opt->pal_pool, $opt->neutral_pool, $opt->foe_pool);
  125. }
  126.  
  127. sub usage () {
  128.     print STDERR $usage->text;
  129.     exit;
  130. }
  131.  
  132. sub newestDateHeader {
  133.     my ($dir) = @_;
  134.  
  135.     my @files = grep { ! ( $_ =~ m|/?\.{1,2}$| ) } glob("$dir/.* $dir/*");
  136.     @files or error "No downloaded files can be found";
  137.  
  138.     my $newestdt;
  139.  
  140.     foreach my $file (@files) {
  141.         next if -l $file || -d _;
  142.         my $date;
  143.         open(my $file_h, '<', $file) or die "Can not read file $file: $!";
  144.         while (my $line = <$file_h>) {
  145.             chomp $line;
  146.             # empty line == we leave the headers to go into the content
  147.             last if $line eq '';
  148.             last if ($date) = ($line =~ m/^\s*Date:\s+(.*)$/m);
  149.         }
  150.         close $file_h;
  151.         if (defined $date) {
  152.             # RFC 2616 (3.3.1) says Date headers MUST be represented in GMT
  153.             my $dt = DateTime::Format::DateParse->parse_datetime( $date, 'GMT' );
  154.             if (! defined $newestdt || DateTime->compare($dt, $newestdt) > 0) {
  155.                 $newestdt = $dt;
  156.             }
  157.         }
  158.     }
  159.  
  160.     return $newestdt;
  161. }
  162.  
  163. =head2 random_first_with_allowed_failure_ratio
  164.  
  165. Returns the result of the first successful application of
  166. $args->{code} on a random element of $args->{list}.
  167. Success is tested using the $args->{is_success} predicate,
  168. called on the value returned by $args->{code}.
  169.  
  170. $args->{allowed_failure_ratio} caps the maximum failure ratio before
  171. giving up.
  172.  
  173. $args->{code} is called with two arguments: the currently (randomly
  174. picked) considered element, and $args->{args}.
  175.  
  176. Any exceptions thrown by $args->{code} is catched.
  177.  
  178. =cut
  179. sub random_first_with_allowed_failure_ratio {
  180.     my $args = shift;
  181.  
  182.     my %tried;
  183.     $tried{$_} = 0 for (@{$args->{list}});
  184.     my $failures = 0;
  185.     my $total = keys %tried;
  186.  
  187.     while ( $failures / $total <= $args->{allowed_failure_ratio} ) {
  188.         my @randomized_left = shuffle grep { ! $tried{$_} } keys(%tried);
  189.         my $picked = $randomized_left[0];
  190.         $tried{$picked}++;
  191.         my $res;
  192.         try {
  193.             $res = $args->{code}->($picked, $args->{args})
  194.         };
  195.         return $res if $args->{is_success}->($res);
  196.         $failures++;
  197.     }
  198.  
  199.     return;
  200. }
  201.  
  202. sub getPoolDateDiff {
  203.     my $args = shift;
  204.  
  205.     random_first_with_allowed_failure_ratio({
  206.         list => $args->{urls},
  207.         code => \&getUrlDateDiff,
  208.         is_success => sub { defined shift },
  209.         allowed_failure_ratio => $allowed_per_pool_failure_ratio,
  210.     });
  211. }
  212.  
  213. sub getUrlDateDiff {
  214.     my $url = shift;
  215.     my $args = shift;
  216.  
  217.     defined $url or error "getUrlDateDiff must be passed an URL";
  218.     debug("getUrlDateDiff: $url");
  219.  
  220.     my $tmpdir = tempdir("XXXXXXXXXX", TMPDIR => 1);
  221.  
  222.     my @curl_options = (
  223.         '--user-agent', $useragent, '--silent',
  224.         '--proto', '=https', '--tlsv1',
  225.         '--head', '--output', catfile($tmpdir, 'headers'),
  226.     );
  227.     push @curl_options, ('--socks5-hostname', $proxy) if defined $proxy;
  228.  
  229.     my @cmdline = ('curl', @curl_options, $url);
  230.  
  231.     # fetch (the page and) referenced resources:
  232.     # images, stylesheets, scripts, etc.
  233.     my $before = DateTime->now->epoch();
  234.     WIFEXITED(system(@cmdline)) or error "Failed to fetch content from $url: $!";
  235.     my $local = DateTime->now->epoch();
  236.     my $newestdt;
  237.     eval { $newestdt = newestDateHeader($tmpdir) };
  238.     if ($EVAL_ERROR =~ m/No downloaded files can be found/) {
  239.         rmtree($tmpdir);
  240.         error "No file could be downloaded from $url.";
  241.     }
  242.  
  243.     rmtree($tmpdir);
  244.  
  245.     defined $newestdt or error "Could not get any Date header";
  246.     my $newest_epoch = $newestdt->epoch();
  247.  
  248.     my $diff = $newest_epoch - $local;
  249.     my $took = $local - $before;
  250.  
  251.     debug("$url (took ${took}s) => diff = $diff second(s)");
  252.  
  253.     return $diff;
  254. }
  255.  
  256. sub adjustDate {
  257.     my ($diff) = @_;
  258.  
  259.     defined $diff or error "adjustDate was passed an undefined diff";
  260.  
  261.     my $local = DateTime->now->epoch();
  262.     my $absdiff = abs($diff);
  263.  
  264.     debug("Median diff: $diff second(s)");
  265.  
  266.     if ( $maxadjust && $absdiff gt $maxadjust ) {
  267.         message("Not setting clock as diff ($diff seconds) is too large.");
  268.     }
  269.     elsif ( $absdiff lt $minadjust) {
  270.         message("Not setting clock as diff ($diff seconds) is too small.");
  271.     }
  272.     else {
  273.         my $newtime = DateTime->now->epoch + $diff;
  274.         message("Setting time to $newtime...");
  275.         if ($set_date) {
  276.             $> = 0 if $runas;
  277.             open(my $fd, "-|", $datecommand, $dateparam, '@' . $newtime)
  278.                 or die "Cannot set run command $datecommand: $!";
  279.             if ( $? != 0 ) {
  280.                 my @output = <$fd>;
  281.                 error "An error occured setting the time\n@output";
  282.             }
  283.             close($fd);
  284.             $> = getpwnam($runas) if $runas;
  285.         }
  286.     }
  287.     if (defined $res_file) {
  288.         $> = 0 if $runas;
  289.         open my $res_h, '>>', $res_file or die "Cannot open res file $res_file: $!";
  290.         print $res_h "$diff\n";
  291.         close $res_h;
  292.         $> = getpwnam($runas) if $runas;
  293.     }
  294. }
  295.  
  296. sub median {
  297.     my @a = sort {$a <=> $b} @_;
  298.     return ($a[$#a/2] + $a[@a/2]) / 2;
  299. }
  300.  
  301. parseCommandLine();
  302. message("Running htpdate.");
  303. my @diffs = grep {
  304.     defined $_
  305. } map {
  306.     my $diff = $_->join();
  307.     if (! defined $diff) {
  308.         error('Aborting as one pool could not be reached');
  309.     }
  310.     $diff;
  311. } map {
  312.     threads->create(\&getPoolDateDiff, { urls => $_ })
  313. } @pools
  314.     or error "No Date header could be received.";
  315. adjustDate(median(@diffs));
  316. done;
  317.